unit TASACSMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, xtasacs, index, ExtCtrls, math, ToolWin, ActnMan,
  ActnCtrls, ActnMenus, XPStyleActnCtrls, ActnList, StdActns, ImgList,
  ComCtrls, runview, resultview, runoptions, RunProperties, Menus, ActnPopup,
  tasacsconfigtypes, tasacsproject, tasacsabstract, datasourcedlg, registry,
  runnamedlg, NewProjectDlg;


type
  TfrmTASACS = class(TForm)
    ActionMainMenuBar1: TActionMainMenuBar;
    ActionToolBar1: TActionToolBar;
    ImageList1: TImageList;
    ActionManager: TActionManager;
    OpenProjectAction: TBrowseForFolder;
    EditCopy: TEditCopy;
    FileExitAction: TFileExit;
    OpenDlg: TOpenDialog;
    ResetAction: TAction;
    RunAction: TAction;
    StepAction: TAction;
    StopAction: TAction;
    tvRun: TTreeView;
    Splitter1: TSplitter;
    StatusBar1: TStatusBar;
    OptionsAction: TAction;
    NewProjectAction: TAction;
    LeftPanePopup: TPopupActionBar;
    HelpAboutAction: TAction;
    PropertiesAction: TAction;
    N1: TMenuItem;
    PropertiesAction1: TMenuItem;
    DataEditorAction: TAction;
    DiagnosticsAction: TAction;
    AddRunToArchive: TAction;
    Addruntoarchive1: TMenuItem;
    GetRunFromArchive: TAction;
    Getrunfromarchive1: TMenuItem;
    RecentProjectAction: TAction;
    procedure PaintBox1Paint(Sender: TObject);
    procedure cbModelTypeClick(Sender: TObject);
    procedure OnExecute(Sender: TObject);
    procedure OnUpdate(Sender: TObject);
    procedure OpenProjectActionAccept(Sender: TObject);
    procedure OpenProjectActionBeforeExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure tvRunDblClick(Sender: TObject);
    procedure tvRunGetImageIndex(Sender: TObject; Node: TTreeNode);
    procedure tvRunMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    m_runsnode : TTreeNode;
    m_Project : ITasacsProject;
    { Private declarations }
    m_RunView : TfrmRunView;
    m_ResultView : TfrmResultView;
    m_RunOptions : TfrmRunOptions;
   m_ActiveRun : Integer;
   m_RunState : Integer;
   procedure ResetDataSourceWeight(Cat, Idx : Integer);
   procedure UpdateActions;
//   procedure ActivateRun(I : Integer);
   procedure AddRunToList(Name : string);
//   function ActiveRunFolder : string;
   function RunsFolder : string;
   function WorkingRunFolder : string;
   function DataFolder : string;
   function ProjectName : string;
   procedure AddWorkingRunToArchive;
   procedure GetArchiveRunFromArchive();
   procedure CopyFileFromWorkingRuntoNewRun(ArchDir, f : string);
   procedure CopyFileFromArchiveRunToWorkingRun(ArchDir, f : string);
   procedure AppendArchiveRun(RunName : string);
  protected
   destructor Destroy; override;
   function ReLoadRun : Boolean;
  public
    constructor Create(AOwner : TComponent); override;
    { Public declarations }
  end; // TfrmTASACS


var
  frmTASACS: TfrmTASACS;


implementation


const s_WorkingRun = 'Working run';
const s_RunArchive = 'Run archive';
const s_Data = 'Data';


{$R *.dfm}


function TasacsRegStrVal(RegVal : string) : string;
var
   Registry : TRegistry;
begin
   Result := '';
   Registry := TRegistry.Create(KEY_READ);
   Registry.RootKey := HKEY_CURRENT_USER;
   if Registry.OpenKey('\Software\Tasacs', false) then
      if Registry.ValueExists(RegVal) then
         Result := Registry.ReadString(RegVal);
   Registry.Free;
end; // TasacsRegStrVal


procedure TasacsRegStrWrite(RegVal, Value : string);
var
   Registry : TRegistry;
begin
   Registry := TRegistry.Create(KEY_WRITE or KEY_READ);
   Registry.RootKey := HKEY_CURRENT_USER;
   if Registry.OpenKey('\Software\Tasacs', true) then
      Registry.WriteString(RegVal, Value);
   Registry.Free;
end; // TasacsRegStrWrite


constructor TfrmTASACS.Create(AOwner : TComponent);
begin
   m_Project := nil;
   inherited Create(AOwner);
end; // TfrmTASACS.Create


destructor TfrmTASACS.Destroy;
begin
   if m_Project <> nil then
      (m_Project as IInterfaceComponentReference).GetComponent.Free;
   m_Project := nil;
   Execute(cmdCloseRun);
   try
   inherited;
   except on E : Exception do
      MessageDlg('Exception occured in TfrmTASACS.Destroy', mtError, [mbok], 0);
   end;
end; // TfrmTASACS.Destroy


procedure TfrmTASACS.FormCreate(Sender: TObject);
begin
   DecimalSeparator := '.';
   m_RunView := nil;
   m_ResultView := nil;
   m_ActiveRun := 0;
   m_RunOptions := TfrmRunOptions.Create(Self);
end; // TfrmTASACS.FormCreate


procedure TfrmTASACS.cbModelTypeClick(Sender: TObject);
begin
//   get_IndexInput__()^.ModelType := cbModelType.ItemIndex;
end; // TfrmTASACS.cbModelTypeClick


function GetRGBFromRate(N, NMax : single) : Integer;
var
   R, G, B : Integer;

   i, Rate : double;
begin
   if N = -1 then
   begin
      // Undefined:
      Result := rgb(0, 0, $FF);
      exit;
   end;
   R := 0;
   G := 0;
   B := 0;
   Rate := N / NMax;
   I := $100 * 3 * Rate;
   if $100 * 2 <= i then
   begin
      B := floor(I - $100 * 2);
      G := $FF;
      R := $FF;
   end
   else if $100 * 1 <= i then
   begin
      B := 0;
      G := floor(I - $100 * 1);
      R := $FF;
   end
   else
   begin
      B := 0;
      G := 0;
      R := floor(I);
   end;
   Result := rgb(R, G, B);
end; // GetRGBFromRate


procedure TfrmTASACS.PaintBox1Paint(Sender: TObject);
var
   iYear, iAge, cellheight, cellwidth, NAges, NYears, Yr, Age,
   XOffset, YOffset : Integer;
   N, F, MaxN, MaxF : single;
   Bitmap : TBitmap;
begin
   MaxN := 0;
   if not g_RunIsLoaded then
      exit;
   Bitmap := TBitmap.Create;
   Bitmap.Width := m_RunView.PaintBox1.Width;
   Bitmap.Height := m_RunView.PaintBox1.Height;
   NAges := NumAges;
   NYears := NumYears;
   with Bitmap.Canvas do
   begin
      Brush.Color := clWhite;
      CellHeight := 7;//floor(PaintBox1.Height / NYears);
      CellWidth := 7;//floor(PaintBox1.Width / NAges);
      FillRect(ClientRect);
      if (NumYears <= 1) or (NumAges <= 1) then
         exit;
      for iYear := 0 to NumYears - 1 do
         for iAge := 0 to NumAges - 1 do
            MaxN := max(get_N(iYear, iAge), MaxN);
      XOffset := 50;
      YOffset := 50;
      Font.Size := 13;
      TextOut(50 + round(CellWidth * NAges * 0.5), 4, 'N');
      TextOut(50 * 2 + round(CellWidth * NAges * 1.5), 4, 'F');
      Font.Size := 8;
      for iAge := 0 to NAges - 1 do
      begin
         Age := round(get_Run_Prop(propFirstAge)) + iAge;
         if Age mod 5 = 0 then
         begin
            Brush.Color := clWhite;
            TextOut(50 + iAge * CellWidth, 30, inttostr(Age));
            TextOut(50 * 2 + CellWidth * NAges + iAge * CellWidth, 30, inttostr(Age));
         end;
      end;

      for iYear := 0 to NYears - 1 do
      begin
         Yr := round(get_Run_Prop(propFirstYear)) + iYear;
         if Yr mod 10 = 0 then
         begin
            Brush.Color := clWhite;
            TextOut(20, 50 + iYear * CellHeight, inttostr(Yr));
         end;
         for iAge := 0 to NAges - 1 do
         begin
            N := get_N(iYear, iAge);
            Brush.Color := GetRGBFromRate(N, strtofloat(m_RunOptions.ebMaxN.Text));
            FillRect(Rect(Xoffset + iAge * CellWidth, YOffset + iYear * CellHeight,
               Xoffset + (iAge + 1) * CellWidth, YOffset + (iYear + 1) * CellHeight));
         end; // for
      end;
      for iYear := 0 to NYears - 1 do
         for iAge := 0 to NAges - 1 do
            MaxF := max((get_F(iYear, iAge)), MaxF);
      XOffset := 50 * 2 + CellWidth * NAges;
      for iYear := 0 to NYears - 1 do
         for iAge := 0 to NAges - 1 do
         begin
            F := (get_F(iYear, iAge));
            Brush.Color := GetRGBFromRate(F, strtofloat(m_RunOptions.ebMaxF.Text));
            FillRect(Rect(Xoffset + iAge * CellWidth, YOffset + iYear * CellHeight,
               Xoffset + (iAge + 1) * CellWidth, YOffset + (iYear + 1) * CellHeight));
         end;
      m_RunView.PaintBox1.Canvas.CopyRect(m_RunView.PaintBox1.ClientRect, Bitmap.Canvas, m_RunView.PaintBox1.ClientRect);
//      PaintBox1.Canvas.Draw(0, 0, Bitmap);
      Bitmap.Free;
   end;
end;


function TfrmTASACS.ReLoadRun : Boolean;
var
   Error : string;
begin
   screen.cursor := crHourglass;
   LoadRun(OpenProjectAction.Folder, s_WorkingRun);
   Result := true;
   Error := trim(get_Run_Prop_Str(propErrorStr));
   if(Error <> '') then
   begin
      screen.cursor := crDefault;
      MessageDlg(Error, mtError, [mbok], 0);
      exit;
   end;
   Result := true;
   g_RunIsLoaded := true;
   m_RunState := rsReset;
   UpdateActions;
(*   m_RunView.PaintBox1.Invalidate;
   m_RunView.PaintBox1.Update;
   m_RunView.Memo1.Clear;
   m_RunView.Caption := tvRun.Items[m_ActiveRun].Text + ' (' + s_ModelDescr[round(get_Run_Prop(propModelType))] + ')';*)
   screen.cursor := crDefault;
end; // TfrmTASACS.ReLoadRun


procedure TfrmTASACS.tvRunDblClick(Sender: TObject);
begin
   PropertiesAction.Execute;
end;


procedure TfrmTASACS.tvRunGetImageIndex(Sender: TObject; Node: TTreeNode);
begin
(*   if (node.data <> nil) then // and (tobject(node.data) is ITasacsRun)then
      node.ImageIndex := 10;*)
   node.SelectedIndex := node.ImageIndex
end;

procedure TfrmTASACS.tvRunMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
   pt : tpoint;
   tn : ttreenode;
begin
   pt.X := X;
   pt.Y := Y;
   tvRun.ClientToScreen(pt);
   tn := tvrun.GetNodeAt(pt.X, pt.Y);
   if tn <> nil then
      tn.Selected := true;
end; // TfrmTASACS.tvRunMouseDown


procedure ExecNewProcess(CmdLine : String);
var
   StartUpInfo: TStartUpInfo;
   ProcessInfo: TProcessInformation;
begin
   FillChar(StartUpInfo, SizeOf(TStartUpInfo), 0);
   with StartUpInfo do
   begin
      cb := SizeOf(TStartUpInfo);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
      wShowWindow := SW_SHOWNORMAL;
   end;
   CreateProcess(nil, PChar(CmdLine), nil, nil, false, DETACHED_PROCESS + NORMAL_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo);
end; // ExecNewProcess


procedure TfrmTASACS.ResetDataSourceWeight(Cat, Idx : Integer);
var
   Year, Age : Integer;
   FirstYear, LastYear, FirstAge, LastAge : Integer;
begin
   get_DataSourceDimensions(Cat - 1, Idx, FirstYear, LastYear, FirstAge, LastAge);
   set_DataSourceDimensions(Cat, Idx, FirstYear, LastYear, FirstAge, LastAge);
   for Year := FirstYear to LastYear do
      for Age := FirstAge to LastAge do
         set_DataSourceValue(Cat, Idx, Year - FirstYear, Age - FirstAge, 1.0);
end; // TfrmDataSourceDlg.ResetDataSourceWeight


procedure TfrmTASACS.OnExecute(Sender: TObject);
var
   frmRunProperties : TfrmRunProperties;
   frmDataSourceDlg : TfrmDataSourceDlg;
   frmNewProject : TfrmNewProject;
   RunIter : Integer;
   Delta, ObjFunc : single;
   ProcessStr, ProjectPath, Error  : string;
   FirstYear, LastYear, FirstAge, LastAge, NumFleets, NumSSB, NumBiomass : Integer;
   I : Integer;
   FileName : string;
begin
   if Sender = NewProjectAction then
   begin
      frmNewProject := TfrmNewProject.Create(Self);
      if (mrOK = frmNewProject.ShowModal) then
      begin
         ProjectPath := frmNewProject.ebLocation.Text + '\' + frmNewProject.ebProjectName.Text;
         if DirectoryExists(ProjectPath) then
            MessageDlg('Error: ' + ProjectPath + ' allready exists!', mtError, [mbOK], 0)
         else if not CreateDir(ProjectPath) then
            MessageDlg('Error: ' + ProjectPath + ' not created!', mtError, [mbOK], 0)
         else
         begin
            CreateDir(ProjectPath + '\' + 'Data');
            CreateDir(ProjectPath + '\' + 'Working run');
            CreateDir(ProjectPath + '\' + 'Run archive');
            FirstYear := strtoint(frmNewProject.ebFirstYear.Text);
            LastYear := strtoint(frmNewProject.ebLastYear.Text);
            FirstAge := strtoint(frmNewProject.ebFirstAge.Text);
            LastAge := strtoint(frmNewProject.ebLastAge.Text);
            NumFleets := NumIndicesFromFile(frmNewProject.sgData.Cells[1, 5 + 1], true);
            NumSSB := NumIndicesFromFile(frmNewProject.sgData.Cells[1, 6 + 1], false);
            NumBiomass := NumIndicesFromFile(frmNewProject.sgData.Cells[1, 7 + 1], false);
            CreateNewProject(ProjectPath, FirstYear, LastYear, FirstAge, LastAge, NumFleets, NumSSB, NumBiomass);
            for I := 0 to length(c_DataSourceEditCategories) - 1 do
               if FileExists(frmNewProject.sgData.Cells[1, I + 1]) then
               begin
                  FileName := frmNewProject.sgData.Cells[1, I + 1];
                  FileName := ExtractFileName(FileName);
                  set_Run_Prop_Str(propCatonFile + c_DataSourceEditCategories[I] - odCaton, FileName);
               end;


            SaveRun__();
            SaveObsData__();

            for I := 0 to length(c_DataSourceEditCategories) - 1 do
            begin
               FileName := frmNewProject.sgData.Cells[1, I + 1];
               if FileExists(FileName) then
                  CopyFile(pchar(FileName), pchar(ProjectPath + '\Data\' + ExtractFileName(FileName)), false);
            end;

            OpenProjectAction.Folder := ProjectPath;
            OpenProjectActionAccept(Self);
            ResetDataSourceWeight(odCanumWeight, 0);
            for I := 0 to NumFleets - 1 do
               ResetDataSourceWeight(odFleetWeight, I);
            for I := 0 to NumSSB - 1 do
               ResetDataSourceWeight(odSSBWeight, I);
            for I := 0 to NumBiomass - 1 do
               ResetDataSourceWeight(odBiomassWeight, I);
            SaveObsData__();
         end;
      end;
      frmNewProject.Free;
   end
   else if Sender = ResetAction then
   begin
      ReLoadRun();
      m_RunView.Memo2.Lines.Text := '';
   end
   else if (Sender = RunAction) then
   begin
      if m_RunState = rsRunning then
      begin
         m_RunState := rsPause;
         UpdateActions;
      end
      else
      begin
         if m_RunState = rsFinished then
         begin
            ResetAction.Execute;
            set_Run_Prop(propRunStage, 0);
         end;
         m_RunState := rsRunning;
         case (round(get_Run_Prop(propProcessType))) of
            ptSingleModelRun: ProcessStr := 'single model run';
            ptBootstrap: ProcessStr := 'bootstrap'
         end; // case
         m_RunView.Memo2.Lines.Text := 'Running ' + ProcessStr;
         // The outer tuning loop with windows output
         // The outer tuning loop has i.e. specific output in the front end and forced idle time processing of user interactions.
         UpdateActions;
         while(m_RunState = rsRunning) do
         begin
            if RunOpt() then
            begin
               m_RunState := rsFinished;
            end
            else
            begin
               RunIter := round(get_Run_Prop(propRunIter));
               Delta := get_Run_Prop(propRunDelta);
               ObjFunc := get_Run_Prop(propRunObjFunc);
               m_RunView.Memo1.Lines.Add(Format('Stage:%3d  Iter:%4d  Delta:%12.6f  Obj:%12.6f',
                  [round(get_Run_Prop(propRunStage)), round(get_Run_Prop(propRunIter)),
                  get_Run_Prop(propRunDelta), get_Run_Prop(propRunObjFunc)]));
(*               m_RunView.Memo1.Lines.Add('Iter: ' + inttostr(RunIter) + ' Delta: ' +
                  floattostr(Delta) + ' ObjFunc: ' +
                  floattostr(ObjFunc));*)
            end;
            Application.ProcessMessages;
            m_RunView.PaintBox1.Invalidate;
            m_RunView.PaintBox1.Update;
            m_ResultView.UpdateCharts;
         end;
         case (m_RunState) of
            rsFinished:
            begin
//               OnOptimisationFinished();
               m_RunView.Memo2.Lines.Text := 'Finished';
               Error := trim(get_Run_Prop_Str(propRunErrorStr));
               if(Error <> '') then
               begin
                  m_RunView.Memo2.Lines.Text := Error;
                  screen.cursor := crDefault;
                  MessageDlg(Error, mtError, [mbok], 0);
                  exit;
               end;
            end;
            rsPause:
            begin
//               OnOptimisationFinished();
               m_RunView.Memo2.Lines.Text := 'Pause';
            end;
         end; // case
      end;
   end
   else if (Sender = StepAction) then
   begin
      if m_RunState = rsFinished then
         ResetAction.Execute;
      m_RunState := rsRunningStep;
      RunOpt();
      m_RunView.Memo1.Lines.Add(Format('Iter:%D4Delta:%F12.6Obj:F12.6', [round(get_Run_Prop(propRunIter)),
         get_Run_Prop(propRunDelta), get_Run_Prop(propRunObjFunc)]));
      m_RunState := rsPause;
      UpdateActions;
   end
   else if (Sender = StopAction) then
   begin
      m_RunState := rsFinished;
//      UpdateActions;
   end
   else if (Sender = OptionsAction) then
   begin
      m_RunOptions.ShowModal;
   end
   {else if(Sender = ActivateRunAction) then
   begin
      if tvRun.Selected = nil then
         exit;
      if(m_ActiveRun <> tvRun.Selected.Index) then
      begin
         ActivateRun(tvRun.Selected.Index);
      end;
   end}
   else if(Sender = PropertiesAction) then
   begin
      if (tvrun.Selected <> nil) and (tvrun.Selected.Data <> nil) then
         if supports(tcomponent(tvrun.Selected.Data), ITasacsRun) then
         begin
            ResetAction.Execute;
            frmRunProperties := TfrmRunProperties.Create(Self);
            if mrok = frmRunProperties.ShowModal then
            begin
               SaveRun__();
               //ResetAction.Execute;
               OpenProjectActionAccept(Self);
            end;
            frmRunProperties.Free;
         end
         else if supports(tcomponent(tvrun.Selected.Data), ITasacsObsData) then
         begin
            frmDataSourceDlg := TfrmDataSourceDlg.Create(Self, tcomponent(tvrun.Selected.Data) as ITasacsObsData, nil);
            frmDataSourceDlg.ShowModal;
            frmDataSourceDlg.Free;
         end;
   end
   else if(Sender = DiagnosticsAction) then
   begin
      ExecNewProcess('tasacstrend.exe "' + OpenProjectAction.Folder + '\' + s_WorkingRun + '"')
   end
   else if(Sender = AddRunToArchive) then
   begin
      AddWorkingRunToArchive();
   end
   else if(Sender = GetRunFromArchive) then
   begin
      GetArchiveRunFromArchive();
   end
   else if Sender = RecentProjectAction then
   begin
      OpenProjectAction.Folder := TasacsRegStrVal('ProjectPath');;
      OpenProjectActionAccept(Self);
   end;
   if m_RunView <> nil then
      m_RunView.PaintBox1.Invalidate;
end;


procedure TfrmTASACS.CopyFileFromWorkingRuntoNewRun(ArchDir, f : string);
var
   oldfile, newfile : string;
begin
   oldfile := OpenProjectAction.Folder + '\' + s_WorkingRun + '\' + f;
   newfile := ArchDir + '\' + f;
   CopyFile(pchar(oldFile), pchar(newfile), false);
end; // CopyFileFromWorkingRuntoNewRun


procedure TfrmTASACS.CopyFileFromArchiveRunToWorkingRun(ArchDir, f : string);
var
   oldfile, newfile : string;
begin
   newfile := OpenProjectAction.Folder + '\' + s_WorkingRun + '\' + f;
   oldfile := ArchDir + '\' + f;
   if FileExists(oldfile) then
      CopyFile(pchar(oldFile), pchar(newfile), false);
end; // CopyFileFromArchiveRuntoWorkingRun


procedure TfrmTASACS.AddWorkingRunToArchive();
var
   frmRunName : TfrmRunName;
   ArchDir : string;
   I : Integer;
   DS : TDataSource;
begin
   frmRunName := TfrmRunName.Create(Self);
   if mrok = frmRunName.ShowModal then
   begin
      ArchDir := OpenProjectAction.Folder + '\' + s_RunArchive + '\' + frmRunName.ebRunName.text;
      if (ArchDir <> '') and not DirectoryExists(ArchDir) then
      begin
         CreateDir(ArchDir);
         CopyFileFromWorkingRuntoNewRun(ArchDir, 'index.txt');
         CopyFileFromWorkingRuntoNewRun(ArchDir, get_Run_Prop_Str(propParamInFile));
         CopyFileFromWorkingRuntoNewRun(ArchDir, get_Run_Prop_Str(propCaNumWeightFile));
         CopyFileFromWorkingRuntoNewRun(ArchDir, get_Run_Prop_Str(propFleetWeightFile));
         CopyFileFromWorkingRuntoNewRun(ArchDir, get_Run_Prop_Str(propSSBWeightFile));
         CopyFileFromWorkingRuntoNewRun(ArchDir, get_Run_Prop_Str(propBiomassWeightFile));
         for I := propParamOutFile to propRetroRecruitFile do
            CopyFileFromWorkingRuntoNewRun(ArchDir, get_Run_Prop_Str(I));
         DS := GetDataSource(odCanum, 0);
         CopyFileFromWorkingRuntoNewRun(ArchDir, DS.BootFile);
         for I := 0 to round(get_Run_Prop(propNumFleetIndices)) - 1 do
         begin
            DS := GetDataSource(odFleet, I);
            CopyFileFromWorkingRuntoNewRun(ArchDir, DS.BootFile);
         end;
         for I := 0 to round(get_Run_Prop(propNumSSBIndices)) - 1 do
         begin
            DS := GetDataSource(odSSB, I);
            CopyFileFromWorkingRuntoNewRun(ArchDir, DS.BootFile);
         end;
         for I := 0 to round(get_Run_Prop(propNumBiomassIndices)) - 1 do
         begin
            DS := GetDataSource(odBiomass, I);
            CopyFileFromWorkingRuntoNewRun(ArchDir, DS.BootFile);
         end;
         AppendArchiveRun(frmRunName.ebRunName.text);
      end;
   end;
   frmRunName.Free;
end; // TfrmTASACS.AddWorkingRunToArchive


procedure DeleteFolderContent(Folder : string);
var
   sr: TSearchRec;
begin
   if FindFirst(Folder + '\*.*', 0, sr) = 0 then
   begin
      repeat
         DeleteFile(Folder + '\' + sr.Name);
      until FindNext(sr) <> 0;
      SysUtils.FindClose(sr);
   end;
end; // DeleteFolderContent


procedure TfrmTASACS.GetArchiveRunFromArchive();
var
   ArchDir, RunName : string;
   I : Integer;
   DS : TDataSource;
begin
   if (mrYes <> MessageDlg('The present working run folder will be cleared. Do you want to continue?', mtWarning, [mbYes, mbNo], 0)) then
      exit;
   DeleteFolderContent(OpenProjectAction.Folder + '\' + s_WorkingRun);
   if (tvRun.selected <> nil) and (tvRun.selected.Data <> nil) and
      (tcomponent(tvRun.selected.Data) is TArchiveRun) then
   begin
      RunName := (TComponent(tvRun.selected.Data) as ITasacsRun).RunName;
      ArchDir := OpenProjectAction.Folder + '\' + s_RunArchive + '\' + RunName;
      if (ArchDir <> '') then
      begin
         CopyFileFromArchiveRunToWorkingRun(ArchDir, 'index.txt');
         CopyFileFromArchiveRunToWorkingRun(ArchDir, get_Run_Prop_Str(propParamInFile));
         CopyFileFromArchiveRunToWorkingRun(ArchDir, get_Run_Prop_Str(propCaNumWeightFile));
         CopyFileFromArchiveRunToWorkingRun(ArchDir, get_Run_Prop_Str(propFleetWeightFile));
         CopyFileFromArchiveRunToWorkingRun(ArchDir, get_Run_Prop_Str(propSSBWeightFile));
         CopyFileFromArchiveRunToWorkingRun(ArchDir, get_Run_Prop_Str(propBiomassWeightFile));
         for I := propParamOutFile to propRetroRecruitFile do
            CopyFileFromArchiveRunToWorkingRun(ArchDir, get_Run_Prop_Str(I));
         // Copy the boostrap input files
      end;
      ResetAction.Execute;
   end;
   DS := GetDataSource(odCanum, 0);
   CopyFileFromArchiveRunToWorkingRun(ArchDir, DS.BootFile);
   for I := 0 to round(get_Run_Prop(propNumFleetIndices)) - 1 do
   begin
      DS := GetDataSource(odFleet, I);
      CopyFileFromArchiveRunToWorkingRun(ArchDir, DS.BootFile);
   end;
   for I := 0 to round(get_Run_Prop(propNumSSBIndices)) - 1 do
   begin
      DS := GetDataSource(odSSB, I);
      CopyFileFromArchiveRunToWorkingRun(ArchDir, DS.BootFile);
   end;
   for I := 0 to round(get_Run_Prop(propNumBiomassIndices)) - 1 do
   begin
      DS := GetDataSource(odBiomass, I);
      CopyFileFromArchiveRunToWorkingRun(ArchDir, DS.BootFile);
   end;
   ResetAction.Execute;
end; // TfrmTASACS.AddWorkingRunToArchive


procedure TfrmTASACS.UpdateActions;
begin
   ResetAction.Update;
   RunAction.Update;
   StepAction.Update;
   StopAction.Update;
end; // TfrmTASACS.UpdateActions


procedure TfrmTASACS.OnUpdate(Sender: TObject);
begin
   if (Sender = NewProjectAction) or
//      (Sender = AddRunAction) or
//      (Sender = RemoveRunAction) or
//      (Sender = ActivateRunAction) or
      (Sender = PropertiesAction) or
      (Sender = HelpAboutAction) or
      (Sender = DiagnosticsAction)
      then
      Enabled := true;
   if (Sender = OptionsAction) then
      TAction(Sender).Enabled := DirectoryExists(OpenProjectAction.Folder)
   else if Sender = ResetAction then
   begin
      TAction(Sender).Enabled := DirectoryExists(OpenProjectAction.Folder) and
         g_RunIsLoaded;
   end
   else if Sender = RunAction then
   begin
      TAction(Sender).Enabled := DirectoryExists(OpenProjectAction.Folder);
      if g_RunIsLoaded and (m_RunState = rsRunning) then
         TAction(Sender).ImageIndex := 7 (*pause image*)
      else
         TAction(Sender).ImageIndex := 6 (*run image*)
   end
   else if Sender = StepAction then
   begin
      TAction(Sender).Enabled := DirectoryExists(OpenProjectAction.Folder) and
         g_RunIsLoaded and
         not (m_RunState in [rsRunningStep]);
   end
   else if Sender = StopAction then
   begin
      TAction(Sender).Enabled := DirectoryExists(OpenProjectAction.Folder) and
         g_RunIsLoaded and
         (m_RunState in [rsRunning, rsPause])
   end
   else if Sender = AddRunToArchive then
      TAction(Sender).Enabled := (tvrun.Selected <> nil) and (tvrun.Selected.Data <> nil) and (TObject(tvrun.Selected.Data) is TWorkingRun)
   else if Sender = GetRunFromArchive then
      TAction(Sender).Enabled := (tvrun.Selected <> nil) and (tvrun.Selected.Data <> nil) and (TObject(tvrun.Selected.Data) is TArchiveRun)
   else if Sender = RecentProjectAction then
   begin
      if TasacsRegStrVal('ProjectPath') = '' then
      begin
         RecentProjectAction.Caption := '{empty}';
         RecentProjectAction.Enabled := false;
      end
      else
      begin
         RecentProjectAction.Caption := TasacsRegStrVal('ProjectPath');
         RecentProjectAction.Enabled := true;
      end;
   end;
end; // TfrmTASACS.OnUpdate


procedure SetFormIconFromImageList(ImageList : TImageList; Index : Integer; Form : TForm);
var
   ic : TIcon;
begin
   ic := TIcon.Create;
   ImageList.GetIcon(Index, ic);
   Form.Icon := ic;
   ic.Free;
end; // SetFormIconFromImageList


(*function TfrmTASACS.ActiveRunFolder : string;
begin
   Result := RunsFolder + '\' + tvRun.Items[m_ActiveRun].Text;
end; // TfrmTASACS.ActiveRunFolder*)


(*procedure TfrmTASACS.ActivateRun(I : Integer);
begin
   m_ActiveRun := I;
   tvRun.Invalidate;
   tvRun.Update;
end; // TfrmTASACS.ActivateRun*)


function TfrmTASACS.RunsFolder : string;
begin
   Result := OpenProjectAction.Folder + '\' + s_RunArchive;
end; // TfrmTASACS.RunsFolder


function TfrmTASACS.WorkingRunFolder : string;
begin
   Result := OpenProjectAction.Folder + '\' + s_Workingrun;
end; // TfrmTASACS.WorkingFolder


function TfrmTASACS.DataFolder : string;
begin
   Result := OpenProjectAction.Folder + '\' + s_Data;
end; // TfrmTASACS.DataFolder


function TfrmTASACS.ProjectName : string;
begin
   Result := ExtractFileName(OpenProjectAction.Folder)
end; // TfrmTASACS.ProjectName


procedure TfrmTASACS.AddRunToList(Name : string);
var
   n : TTreeNode;
begin
   n := tvRun.Items.Add(nil, Name);
   n.SelectedIndex := -1;
end;


procedure TfrmTASACS.AppendArchiveRun(RunName : string);
var
   runnode : TTreeNode;
   ArchiveRun : TArchiveRun;
begin
   ArchiveRun := TArchiveRun.create((m_Project as IInterfaceComponentReference).GetComponent, RunName);
   runnode := tvRun.Items.AddChildObject(m_runsnode, RunName, pointer(ArchiveRun));
   runnode.ImageIndex := 15;
end; // TfrmTASACS.AppendArchiveRun


procedure TfrmTASACS.OpenProjectActionAccept(Sender: TObject);
var
   sr : TSearchRec;
   projectnode, datanode, dataitemnode, workrunnode : TTreenode;
   I, Cat, NumIdx, CatIdx : Integer;
   dataitemname : string;
   obsdata : ITasacsObsData;
begin
   tvRun.Items.Clear;
   if DirectoryExists(OpenProjectAction.Folder) then
   begin
      if not ReloadRun() then
         exit;
      if not Directoryexists(OpenProjectAction.Folder + '\' + 'Run archive') then
         CreateDir(OpenProjectAction.Folder + '\' + 'Run archive');
      TasacsRegStrWrite('ProjectPath', OpenProjectAction.Folder);
      m_Project := TTasacsProject.create(Self, ExtractFileName(OpenProjectAction.Folder)) as ITasacsProject;
      projectnode := tvRun.Items.AddObject(nil, m_Project.ProjectName,
         Pointer((m_Project as IInterfaceComponentReference).GetComponent));
      projectnode.ImageIndex := 10;
      projectnode.Expand(false);
      datanode := tvRun.Items.AddChildObject(projectnode, s_Data, nil);
      datanode.ImageIndex := 13;
      workrunnode := tvRun.Items.AddChildObject(projectnode, s_WorkingRun,
         Pointer((m_Project.WorkingRun as IInterfaceComponentReference).GetComponent));
      workrunnode.ImageIndex := 16;
      workrunnode.Expand(false);
      m_runsnode := tvRun.Items.AddChildObject(projectnode, s_RunArchive, nil);
      m_runsnode.ImageIndex := 14;
      Self.Caption := 'TASACS Stock Assessment ' + '[' +
         ExtractFileName(OpenProjectAction.Folder) + ']';
      if DirectoryExists(RunsFolder) then
         if FindFirst(RunsFolder + '\*.*', faDirectory, sr) = 0 then
         repeat
            if (sr.Name <> '.') and (sr.Name <> '..') then
            begin
               AppendArchiveRun(sr.Name)
            end;
         until 0 <> FindNext(sr);
      m_Project.CreateObsData();
      for I := 0 to m_Project.NumObsData  - 1 do
      begin
         obsdata := m_Project.ObsData[I];
         dataitemnode := tvRun.Items.AddChildObject(datanode, obsdata.Name,
            Pointer((obsdata as IInterfaceComponentReference).GetComponent));
         dataitemnode.ImageIndex := 12;
      end;
      if m_RunView = nil then
      begin
         m_RunView := TfrmRunView.Create(Self);
         SetFormIconFromImageList(ImageList1, 16, m_RunView);
         m_RunView.PaintBox1.OnPaint := PaintBox1Paint;
         m_RunView.Memo1.Clear;
         m_ResultView := TfrmResultView.Create(Self);
         SetFormIconFromImageList(ImageList1, 16, m_ResultView);
      end;
      {if 0 < tvRun.Items.count then
         ActivateRun(0);}
     tvRun.Items[0].Expand(true);
   end;
//   treeview1.Items[0].Text := ExtractFileName(OpenProjectAction.Folder);
end; // TfrmTASACS.OpenProjectActionAccept


procedure TfrmTASACS.OpenProjectActionBeforeExecute(Sender: TObject);
begin
   (Sender as TBrowseForFolder).Folder := TasacsRegStrVal('ProjectPath');
//   (Sender as TBrowseForFolder).Folder := GetCurrentDir;
end; // TfrmTASACS.OpenProjectActionBeforeExecute


end.
